home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtfontse.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  26.0 KB  |  600 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtFontselector;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  3.00     | 18.01.92 |  Hp  |                                        *
  28.  *-----------+----------+------+----------------------------------------*)
  29.  
  30.  
  31.  
  32. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  33. (*                                              *)
  34. (*$R-   Range-Checks                            *)
  35. (*$S-   Stack-Check                             *)
  36. (*                                              *)
  37. (*----------------------------------------------*)
  38.  
  39.  
  40. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  41.  
  42.  
  43.  
  44.  
  45. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  46.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  47.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  48.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  49.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  50.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  51.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  52.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  FROM SYSTEM IMPORT  ADDRESS, ADR, CADR, BYTE, TSIZE; 
  60.  
  61.  
  62.  
  63. FROM MagicStrings       IMPORT  Append, Assign, Length;
  64. FROM MagicConvert       IMPORT  IntToStr, StrToInt;
  65. FROM mtAppl             IMPORT  CharHeight, CharWidth, BoxWidth, BoxHeight,
  66.                                 MaxHeight, MaxWidth;
  67. FROM MagicAES           IMPORT  SELECTED, OUTLINED, TOUCHEXIT, HIDETREE,
  68.                                 SELECTABLE, Exit, DEFAULT, DISABLED, CHECKED;
  69. FROM mtFonts            IMPORT  ErrNoFonts, ErrNoGdos, ErrLessMem, ErrWorkstation,
  70.                                 LoadFonts, UnloadFonts, FFIRST, FNEXT, FPREV,
  71.                                 FLAST, FontList, tFontinfo, FontInfo, FontActive,
  72.                                 FontSelect, FontSize, FontDefsize, NextBigger,
  73.                                 NextSmaller, FontColor, FontEffekt, FontRotate,
  74.                                 FontWidth, FontSkew, FontExtent, FontError;
  75.  
  76. IMPORT  MagicTypes, MagicAES, MagicVDI, MagicDOS, MagicBIOS,
  77.         MagicSys, mtAppl, mtDials, mtUtils, mtFonts, mtRsc;
  78.  
  79. (*----------------------------------------------------------------------*
  80.  *        Resource-Coder 1.03  (C)92 by Peter Hellinger Software        *
  81.  *----------------------------------------------------------------------*
  82.  *           Inline-Resource erzeugt am 02.02.1992 20:16:50             *
  83.  *----------------------------------------------------------------------*)
  84.  
  85. TYPE tRscData = ARRAY [0..684] OF CARDINAL;
  86.  
  87. CONST RscData = tRscData {
  88.                  00001H, 00188H, 0016CH, 00188H, 0016CH, 0016CH, 00024H, 
  89.                  0016CH, 0016CH, 00548H, 00028H, 00003H, 00001H, 00000H, 
  90.                  00000H, 00000H, 00000H, 00554H, 03031H, 03233H, 03435H, 
  91.                  03637H, 03839H, 03031H, 03233H, 03435H, 03637H, 03839H, 
  92.                  03031H, 03233H, 03435H, 03637H, 03839H, 03031H, 03233H, 
  93.                  03435H, 03637H, 03839H, 03031H, 03200H, 03031H, 03233H, 
  94.                  03435H, 03637H, 03839H, 03031H, 03233H, 03435H, 03637H, 
  95.                  03839H, 03031H, 03233H, 03435H, 03637H, 03839H, 03031H, 
  96.                  03200H, 07072H, 06F70H, 06F72H, 07469H, 06F6EH, 0616CH, 
  97.                  0005BH, 04772H, 0949EH, 0653AH, 00030H, 03132H, 03334H, 
  98.                  0005BH, 06665H, 07474H, 0005BH, 06865H, 06C6CH, 0005BH, 
  99.                  06B75H, 07273H, 06976H, 0005BH, 0756EH, 07465H, 07273H, 
  100.                  07472H, 06963H, 06865H, 06E00H, 0756DH, 05B72H, 0616EH, 
  101.                  06465H, 07400H, 05B42H, 07265H, 06974H, 0653AH, 00030H, 
  102.                  03132H, 03334H, 00030H, 03132H, 03334H, 0005BH, 04E65H, 
  103.                  06967H, 0756EH, 0673AH, 0005BH, 04F6BH, 0005BH, 04162H, 
  104.                  06272H, 07563H, 06800H, 03031H, 03233H, 03435H, 03637H, 
  105.                  03839H, 03031H, 03233H, 03435H, 03637H, 03839H, 03031H, 
  106.                  03233H, 03435H, 03600H, 02D39H, 03939H, 03900H, 05765H, 
  107.                  07274H, 03A20H, 05F5FH, 05F5FH, 05F00H, 03939H, 03939H, 
  108.                  03900H, 0205BH, 04162H, 06272H, 07563H, 06820H, 0005BH, 
  109.                  04F6BH, 00046H, 06F6EH, 07461H, 07573H, 07761H, 0686CH, 
  110.                  00047H, 07294H, 09E65H, 02065H, 0696EH, 07374H, 0656CH, 
  111.                  06C65H, 06E00H, 04272H, 06569H, 07465H, 02065H, 0696EH, 
  112.                  07374H, 0656CH, 06C65H, 06E00H, 04E65H, 06967H, 0756EH, 
  113.                  06720H, 06569H, 06E73H, 07465H, 06C6CH, 0656EH, 000FFH, 
  114.                  00000H, 00102H, 00000H, 00108H, 00000H, 00114H, 00003H, 
  115.                  00006H, 00000H, 01180H, 00000H, 0FFFFH, 00006H, 0000CH, 
  116.                  0FFFFH, 00001H, 0001CH, 00014H, 00000H, 00010H, 00002H, 
  117.                  01100H, 00002H, 00001H, 00030H, 00812H, 00002H, 0FFFFH, 
  118.                  0FFFFH, 01119H, 00000H, 00010H, 00001H, 01100H, 0002EH, 
  119.                  00000H, 00002H, 00001H, 00003H, 0FFFFH, 0FFFFH, 0131CH, 
  120.                  00000H, 00010H, 00000H, 00024H, 00002H, 00001H, 0002BH, 
  121.                  00001H, 00004H, 0FFFFH, 0FFFFH, 00014H, 00000H, 00000H, 
  122.                  000FFH, 01100H, 00002H, 00003H, 0002BH, 00004H, 00005H, 
  123.                  0FFFFH, 0FFFFH, 0001AH, 00040H, 00000H, 00000H, 00050H, 
  124.                  00002H, 00008H, 00023H, 00001H, 00006H, 0FFFFH, 0FFFFH, 
  125.                  0001BH, 00040H, 00000H, 004FFH, 01100H, 00026H, 00008H, 
  126.                  00003H, 00001H, 00007H, 0FFFFH, 0FFFFH, 0001BH, 00040H, 
  127.                  00000H, 003FFH, 01100H, 0002AH, 00008H, 00003H, 00001H, 
  128.                  00008H, 0FFFFH, 0FFFFH, 0121AH, 00000H, 00000H, 00000H, 
  129.                  00072H, 00002H, 0000AH, 00011H, 00001H, 00009H, 0FFFFH, 
  130.                  0FFFFH, 0131CH, 00040H, 00000H, 00000H, 0007FH, 00015H, 
  131.                  0000AH, 00007H, 00001H, 0000AH, 0FFFFH, 0FFFFH, 0001AH, 
  132.                  00040H, 00000H, 00000H, 00087H, 0001FH, 0000AH, 00006H, 
  133.                  00001H, 0000BH, 0FFFFH, 0FFFFH, 0001BH, 00040H, 00000H, 
  134.                  002FFH, 01100H, 00026H, 0000AH, 00003H, 00001H, 0000CH, 
  135.                  0FFFFH, 0FFFFH, 0001BH, 00040H, 00000H, 001FFH, 01100H, 
  136.                  0002AH, 0000AH, 00003H, 00001H, 00012H, 0000DH, 00011H, 
  137.                  00014H, 00000H, 00000H, 000FFH, 00130H, 00001H, 0000CH, 
  138.                  00013H, 00805H, 0000EH, 0FFFFH, 0FFFFH, 0121AH, 00041H, 
  139.                  00000H, 00000H, 0008DH, 00001H, 00000H, 00011H, 00001H, 
  140.                  0000FH, 0FFFFH, 0FFFFH, 0121AH, 00041H, 00000H, 00000H, 
  141.                  00093H, 00001H, 00001H, 00011H, 00001H, 00010H, 0FFFFH, 
  142.                  0FFFFH, 0121AH, 00041H, 00000H, 00000H, 00099H, 00001H, 
  143.                  00002H, 00011H, 00001H, 00011H, 0FFFFH, 0FFFFH, 0121AH, 
  144.                  00041H, 00000H, 00000H, 000A1H, 00001H, 00003H, 00011H, 
  145.                  00001H, 0000CH, 0FFFFH, 0FFFFH, 0121AH, 00041H, 00000H, 
  146.                  00000H, 000B0H, 00001H, 00004H, 00011H, 00001H, 00013H, 
  147.                  0FFFFH, 0FFFFH, 0131CH, 00040H, 00000H, 00000H, 000BAH, 
  148.                  00015H, 0000CH, 00008H, 00001H, 0001AH, 00014H, 00019H, 
  149.                  00014H, 00000H, 00000H, 00000H, 01130H, 0001EH, 0000CH, 
  150.                  0000FH, 00003H, 00015H, 0FFFFH, 0FFFFH, 0001AH, 00040H, 
  151.                  00000H, 00000H, 000C3H, 00001H, 00000H, 00006H, 00001H, 
  152.                  00016H, 0FFFFH, 0FFFFH, 0001BH, 00040H, 00000H, 02DFFH, 
  153.                  01100H, 00008H, 00000H, 00003H, 00001H, 00017H, 0FFFFH, 
  154.                  0FFFFH, 0001BH, 00040H, 00000H, 02BFFH, 01100H, 0000CH, 
  155.                  00000H, 00003H, 00001H, 00018H, 0FFFFH, 0FFFFH, 0001AH, 
  156.                  00040H, 00000H, 00000H, 000C9H, 00001H, 00002H, 00006H, 
  157.                  00001H, 00019H, 0FFFFH, 0FFFFH, 0001BH, 00040H, 00000H, 
  158.                  02FFFH, 01100H, 00008H, 00002H, 00003H, 00001H, 00013H, 
  159.                  0FFFFH, 0FFFFH, 0001BH, 00040H, 00000H, 02AFFH, 01100H, 
  160.                  0000CH, 00002H, 00003H, 00001H, 0001BH, 0FFFFH, 0FFFFH, 
  161.                  0131CH, 00040H, 00000H, 00000H, 000CFH, 00015H, 0000EH, 
  162.                  00009H, 00001H, 0001CH, 0FFFFH, 0FFFFH, 0121AH, 00007H, 
  163.                  00000H, 00000H, 000D9H, 00015H, 00010H, 0000BH, 00001H, 
  164.                  00000H, 0FFFFH, 0FFFFH, 0121AH, 00425H, 00000H, 00000H, 
  165.                  000DDH, 00022H, 00010H, 0000BH, 00001H, 0FFFFH, 00001H, 
  166.                  00005H, 00014H, 00000H, 00010H, 00002H, 01100H, 00002H, 
  167.                  00001H, 00020H, 00007H, 00002H, 0FFFFH, 0FFFFH, 01119H, 
  168.                  00000H, 00010H, 00001H, 01100H, 0001EH, 00000H, 00002H, 
  169.                  00001H, 00003H, 0FFFFH, 0FFFFH, 0131CH, 00000H, 00010H, 
  170.                  00000H, 000E6H, 00002H, 00001H, 0001BH, 00001H, 00004H, 
  171.                  0FFFFH, 0FFFFH, 0001DH, 00008H, 00000H, 00000H, 0016CH, 
  172.                  0000AH, 00003H, 0000BH, 00001H, 00005H, 0FFFFH, 0FFFFH, 
  173.                  0121AH, 00405H, 00000H, 00000H, 0011AH, 00012H, 00005H, 
  174.                  0000BH, 00001H, 00000H, 0FFFFH, 0FFFFH, 0121AH, 00027H, 
  175.                  00000H, 00000H, 00125H, 00005H, 00005H, 0000BH, 00001H, 
  176.                  0FFFFH, 00001H, 00004H, 00014H, 00000H, 00000H, 000FFH, 
  177.                  01100H, 00001H, 00001H, 00017H, 00006H, 00002H, 0FFFFH, 
  178.                  0FFFFH, 0001CH, 00000H, 00000H, 00000H, 00129H, 00002H, 
  179.                  00001H, 0000BH, 00001H, 00003H, 0FFFFH, 0FFFFH, 0001CH, 
  180.                  00000H, 00000H, 00000H, 00135H, 00002H, 00002H, 00010H, 
  181.                  00001H, 00004H, 0FFFFH, 0FFFFH, 0001CH, 00000H, 00000H, 
  182.                  00000H, 00146H, 00002H, 00003H, 00011H, 00001H, 00000H, 
  183.                  0FFFFH, 0FFFFH, 0001CH, 00020H, 00000H, 00000H, 00158H, 
  184.                  00002H, 00004H, 00012H, 00001H, 00000H, 00188H, 00000H, 
  185.                  00440H, 00000H, 004D0H, 00000H, 00000H, 00000H
  186.                  }; (* Ende RscData *) 
  187.  
  188.  
  189.  
  190. (*----------------------------------------------------------------------*)
  191.  
  192.  
  193. CONST   Selector =   0;  (* Formular/Dialog *)
  194.         Titel    =   2;  (* STRING in Baum SELECTOR *)
  195.         Fontfeld =   3;  (* BOX in Baum SELECTOR *)
  196.         Font     =   4;  (* BUTTON in Baum SELECTOR *)
  197.         Fontdown =   5;  (* BOXCHAR in Baum SELECTOR *)
  198.         Fontup   =   6;  (* BOXCHAR in Baum SELECTOR *)
  199.         Proports =   7;  (* BUTTON in Baum SELECTOR *)
  200.         Point    =   8;  (* STRING in Baum SELECTOR *)
  201.         Pointstr =   9;  (* BUTTON in Baum SELECTOR *)
  202.         Pointdwn =  10;  (* BOXCHAR in Baum SELECTOR *)
  203.         Pointup  =  11;  (* BOXCHAR in Baum SELECTOR *)
  204.         Effektbk =  12;  (* BOX in Baum SELECTOR *)
  205.         Fat      =  13;  (* BUTTON in Baum SELECTOR *)
  206.         Light    =  14;  (* BUTTON in Baum SELECTOR *)
  207.         Italic   =  15;  (* BUTTON in Baum SELECTOR *)
  208.         Underlin =  16;  (* BUTTON in Baum SELECTOR *)
  209.         Outline  =  17;  (* BUTTON in Baum SELECTOR *)
  210.         Size     =  18;  (* STRING in Baum SELECTOR *)
  211.         Fsmbak   =  19;  (* BOX in Baum SELECTOR *)
  212.         Sizestr  =  20;  (* BUTTON in Baum SELECTOR *)
  213.         Sizedown =  21;  (* BOXCHAR in Baum SELECTOR *)
  214.         Sizeup   =  22;  (* BOXCHAR in Baum SELECTOR *)
  215.         Skewstr  =  23;  (* BUTTON in Baum SELECTOR *)
  216.         Skewdown =  24;  (* BOXCHAR in Baum SELECTOR *)
  217.         Skewup   =  25;  (* BOXCHAR in Baum SELECTOR *)
  218.         Skew     =  26;  (* STRING in Baum SELECTOR *)
  219.         Ok       =  27;  (* BUTTON in Baum SELECTOR *)
  220.         Cancel   =  28;  (* BUTTON in Baum SELECTOR *)
  221.  
  222. CONST   Edit     =   1;  (* Formular/Dialog *)
  223.         Etitel   =   2;  (* STRING in Baum EDIT *)
  224.         Editfeld =   3;  (* FTEXT in Baum EDIT *)
  225.         Editcncl =   4;  (* BUTTON in Baum EDIT *)
  226.         Editok   =   5;  (* BUTTON in Baum EDIT *)
  227.  
  228. CONST   Strings  =   2;  (* Formular/Dialog *)
  229.         Stitel   =   1;  (* STRING in Baum STRINGS *)
  230.         Spoints  =   2;  (* STRING in Baum STRINGS *)
  231.         Ssize    =   3;  (* STRING in Baum STRINGS *)
  232.         Sskew    =   4;  (* STRING in Baum STRINGS *)
  233.  
  234.  
  235. VAR     attr:           ARRAY [0..9] OF sINTEGER;
  236.         j, i, s:        sINTEGER;
  237.         b, first:       BOOLEAN;
  238.         clip, r1, r2:   mtUtils.tRect;
  239.         small:          mtUtils.tRect;
  240.         rsc:            mtRsc.RESOURCE;
  241.         selector:       mtUtils.tObjcTree;
  242.         editdial:       mtUtils.tObjcTree;
  243.         strings:        mtUtils.tObjcTree;
  244.         gdos:           lCARDINAL;
  245.         rscData:        POINTER TO tRscData;
  246.        
  247. VAR     message:        ARRAY [0..50] OF CHAR;
  248.         namestr:        ARRAY [0..40] OF CHAR;
  249.         pointstr:       ARRAY [0..6] OF CHAR;
  250.         widthstr:       ARRAY [0..6] OF CHAR;
  251.         skewstr:        ARRAY [0..6] OF CHAR;
  252.         editfeld:       ARRAY [0..10] OF CHAR;
  253.         stitel:         ARRAY [0..30] OF CHAR;
  254.         spoints:        ARRAY [0..30] OF CHAR;
  255.         ssize:          ARRAY [0..30] OF CHAR;
  256.         sskew:          ARRAY [0..30] OF CHAR;
  257.  
  258. VAR     old:            tFontinfo; (* ID *)
  259.         act:            tFontinfo;
  260.  
  261.  
  262. PROCEDURE EditDial (REF msg: ARRAY OF CHAR; value, objekt: sINTEGER): sINTEGER;
  263. VAR i: sINTEGER;
  264.     b: BOOLEAN;
  265.     s, c: mtUtils.tRect;
  266. BEGIN
  267.  mtUtils.ObjcArea (selector, objekt, s);
  268.  mtDials.DialForm (selector, mtDials.DDISABLE, r2, r2);
  269.  mtUtils.SetObjcString (editdial, Etitel, msg);
  270.  IntToStr (value, 0, editfeld);
  271.  mtUtils.SetObjcString (editdial, Editfeld, editfeld);
  272.  mtDials.DialCenter (editdial, mtDials.CSCREEN, 0, 0, c);
  273.  mtDials.DialForm (editdial, mtDials.DSTART, r2, r2);
  274.  mtDials.DialForm (editdial, mtDials.DGROW, s, c);
  275.  mtDials.DialDraw (editdial, 0, 8, c, FALSE);
  276.  LOOP
  277.   mtAppl.MouseArrow;
  278.   i:= mtDials.DialDo (editdial, Editfeld);
  279.   b:= mtUtils.DoubleClick (i);
  280.   CASE i OF 
  281.    Editcncl:    EXIT;
  282.                 |
  283.    Editok:      mtUtils.ObjcString (editdial, Editfeld, editfeld);
  284.                 value:= StrToInt (editfeld);
  285.                 EXIT;
  286.                 |
  287.    ELSE         ;
  288.   END;
  289.  END;
  290.  EXCL (editdial^[i].obState, MagicAES.SELECTED);
  291.  mtDials.DialForm (editdial, mtDials.DSHRINK, s, c);
  292.  mtDials.DialForm (editdial, mtDials.DFINISH, r2, r2);
  293.  mtDials.DialForm (selector, mtDials.DENABLE, r2, r2);
  294.  RETURN value;
  295. END EditDial;
  296.  
  297. PROCEDURE DrawFontfeld (handle: sINTEGER);
  298. BEGIN
  299.  (* Fontdisplay *)
  300.  mtDials.DialDraw (selector, Fontfeld, 0, clip, FALSE);
  301.  mtUtils.ObjcPos (selector, Fontfeld, r1.x, r1.y);
  302.  r1.w:= r1.x + selector^[Fontfeld].obWidth - 1;
  303.  r1.h:= r1.y + selector^[Fontfeld].obHeight - 1;
  304.  mtAppl.MouseOff;
  305.  MagicVDI.SetClipping (handle, r1, TRUE);
  306.  MagicVDI.Text (handle, r1.x + 5, r1.y + 5, 'The quick brown fox jumps over the lazy dog');
  307.  MagicVDI.SetClipping (handle, r1, FALSE);
  308.  mtAppl.MouseOn;
  309. END DrawFontfeld;
  310.  
  311. PROCEDURE DrawEffects (handle: sINTEGER; seleffekt: BOOLEAN);
  312. VAR e: BOOLEAN;
  313.     i: INTEGER;
  314. BEGIN
  315.  IF seleffekt THEN
  316.   FOR i:= 0 TO 4 DO
  317.    mtUtils.SetState (selector, Fat + i, SELECTED, CastToCard (i) IN act.effect);
  318.    mtUtils.SetState (selector, Fat + i, DISABLED, FALSE);
  319.   END;
  320.   e:= TRUE;
  321.  ELSE
  322.   IF NOT (DISABLED IN selector^[Fat].obState) THEN
  323.    FOR i:= 0 TO 4 DO
  324.     mtUtils.SetState (selector, Fat + i, DISABLED, TRUE);
  325.    END;
  326.    e:= TRUE;
  327.   END;
  328.  END;
  329.  IF e THEN
  330.   mtDials.DialDraw (selector, Effektbk, 8, clip, FALSE);
  331.  END;
  332. END DrawEffects;
  333.  
  334. PROCEDURE Update (handle: sINTEGER; seleffekt, draw: BOOLEAN);
  335. (* Dialog auf die aktuellen Werte einstellen *) 
  336. VAR i: sINTEGER;
  337.     e, v: BOOLEAN;
  338. BEGIN
  339.  v:= FALSE;  e:= FALSE;
  340.  Assign (act.name, namestr);  IntToStr (act.point, 4, pointstr);
  341.  IF act.fsm THEN
  342.   IntToStr (act.width, 4, widthstr);
  343.   IntToStr (ABS (act.skew DIV 10), 4, skewstr);
  344.   IF act.skew < 0 THEN  skewstr[0]:= 'R';
  345.   ELSIF act.skew > 0 THEN skewstr[0]:= 'L';
  346.   END;
  347.   IF DISABLED IN selector^[Sizestr].obState THEN
  348.    EXCL (selector^[Sizestr ].obState, DISABLED);
  349.    EXCL (selector^[Sizeup  ].obState, DISABLED);
  350.    EXCL (selector^[Sizedown].obState, DISABLED);
  351.    EXCL (selector^[Skewstr ].obState, DISABLED);
  352.    EXCL (selector^[Skewup  ].obState, DISABLED);
  353.    EXCL (selector^[Skewdown].obState, DISABLED);
  354.   END;
  355.   v:= TRUE;
  356.  ELSE
  357.   IF NOT (DISABLED IN selector^[Sizestr].obState) THEN
  358.    Assign ('   0', widthstr);
  359.    Assign ('   0', skewstr);
  360.    INCL (selector^[Sizestr ].obState, DISABLED);
  361.    INCL (selector^[Sizeup  ].obState, DISABLED);
  362.    INCL (selector^[Sizedown].obState, DISABLED);
  363.    INCL (selector^[Skewstr ].obState, DISABLED);
  364.    INCL (selector^[Skewup  ].obState, DISABLED);
  365.    INCL (selector^[Skewdown].obState, DISABLED);
  366.    v:= TRUE;
  367.   END;
  368.  END;
  369.  mtUtils.SetState (selector, Proports, SELECTED, NOT act.mono);
  370.  IF draw THEN
  371.   DrawFontfeld (handle);
  372.   mtDials.DialDraw (selector, Font, 0, clip, FALSE);
  373.   mtDials.DialDraw (selector, Pointstr, 0, clip, FALSE);
  374.   mtDials.DialDraw (selector, Proports, 0, clip, FALSE);
  375.   DrawEffects (handle, seleffekt);
  376.   IF v THEN  mtDials.DialDraw (selector, Fsmbak, 8, clip, FALSE);  END;
  377.  END;
  378. END Update;
  379.                 
  380. PROCEDURE FontSelector (handle: INTEGER; REF msg: ARRAY OF CHAR;
  381.                         seleffekt, mono: BOOLEAN;
  382.                         VAR font, point, width, skew: sINTEGER;
  383.                         VAR effekt: sBITSET): BOOLEAN;
  384.  
  385. VAR selok: BOOLEAN;
  386.     color, x: sINTEGER;
  387.  
  388.  PROCEDURE OtherFont (start, next: sINTEGER);
  389.  VAR f: sINTEGER;
  390.      inf: tFontinfo;
  391.  BEGIN
  392.   mtAppl.MouseBusy;
  393.   LOOP
  394.    f:= FontList (handle, next);
  395.    IF f = 0 THEN  f:= FontList (handle, start);  END;
  396.    FontInfo (handle, f, inf);
  397.    IF (inf.mono AND mono) OR (NOT mono) THEN  EXIT; END;
  398.   END;
  399.   FontSelect (handle, f, FALSE);
  400.   FontInfo (handle, f, act);
  401.   Update (handle, seleffekt, TRUE);
  402.  END OtherFont;
  403.  
  404. BEGIN
  405.  selok:= FALSE;
  406.  
  407.  (* Erstmal aktuelle Daten feststellen *)
  408.  FontInfo (handle, FontActive (handle), old);
  409.  FontInfo (handle, FontActive (handle), act);
  410.  
  411.  color:= old.color;
  412.  j:= MagicVDI.SetTextcolor (handle, 1);
  413.  
  414.  IF msg[0] # 0C THEN  mtUtils.SetObjcString (selector, Titel, msg);
  415.                 ELSE  mtUtils.SetObjcString (selector, Titel, 'Fontauswahl');
  416.  END;
  417.  
  418.  mtAppl.StoreMouse;
  419.  
  420.  mtDials.DialCenter (selector, mtDials.CSCREEN, 0, 0, clip);
  421.  mtDials.DialForm (selector, mtDials.DSTART, r2, r2);
  422.  mtDials.DialForm (selector, mtDials.DGROW, small, clip);
  423.  mtDials.DialDraw (selector, 0, 8, clip, FALSE);
  424.  (* Wir k”nnen erst jetzt den Dialog aktualisieren! *)
  425.  Update (handle, seleffekt, FALSE);
  426.  DrawFontfeld (handle);
  427.  
  428.  LOOP
  429.   mtAppl.MouseArrow;
  430.   i:= mtDials.DialDo (selector, -1);
  431.   b:= mtUtils.DoubleClick (i);
  432.   CASE i OF
  433.    Fontup:      OtherFont (FFIRST, FNEXT);
  434.                 |
  435.    Fontdown:    OtherFont (FLAST, FPREV);
  436.                 |
  437.    Fat,
  438.    Italic,
  439.    Underlin,
  440.    Light,
  441.    Outline:     IF seleffekt THEN
  442.                  x:= i - Fat;
  443.                  IF (CastToCard (x) IN act.effect) THEN
  444.                   EXCL (act.effect, i - Fat);
  445.                  ELSE
  446.                   INCL (act.effect, i - Fat);
  447.                  END;
  448.                  FontEffekt (handle, act.effect);
  449.                  FontInfo (handle, FontActive (handle), act);
  450.                  DrawFontfeld (handle);
  451.                 END;
  452.                 |
  453.    Point,
  454.    Pointstr,
  455.    Pointup,
  456.    Pointdwn:    CASE i OF
  457.                  Pointdwn:  j:= NextSmaller (handle);|
  458.                  Pointup:   j:= NextBigger (handle);|
  459.                  ELSE j:= act.point;
  460.                       act.point:= EditDial ('Gr”že einstellen', act.point, Pointstr);
  461.                       IF j # act.point THEN
  462.                        act.point:= FontSize (handle, act.point, j, j, j, j);
  463.                       END;
  464.                 END;
  465.                 IF j # act.point THEN
  466.                  FontInfo (handle, FontActive (handle), act);
  467.                  Update (handle, seleffekt, FALSE);
  468.                  DrawFontfeld (handle);
  469.                  mtDials.DialDraw (selector, Pointstr, 0, clip, FALSE);
  470.                 END;
  471.                 |
  472.    Size,
  473.    Sizestr,
  474.    Sizedown,
  475.    Sizeup:      IF act.fsm THEN
  476.                  CASE i OF
  477.                   Sizeup:   INC (act.width);|
  478.                   Sizedown: DEC (act.width);|
  479.                   ELSE act.width:= EditDial ('Breite einstellen', act.width, Sizestr);
  480.                  END;
  481.                  FontWidth (handle, act.width);
  482.                  FontInfo (handle, FontActive (handle), act);
  483.                  Update (handle, seleffekt, FALSE);
  484.                  DrawFontfeld (handle);
  485.                  mtDials.DialDraw (selector, Sizestr, 0, clip, FALSE);
  486.                 END;
  487.                 |
  488.    Skew,
  489.    Skewstr,
  490.    Skewup,
  491.    Skewdown:    IF act.fsm THEN
  492.                  CASE i OF
  493.                   Skewup:   IF act.skew > -900 THEN  DEC (act.skew, 10);  END;|
  494.                   Skewdown: IF act.skew < 900 THEN  INC (act.skew, 10);  END;|
  495.                   ELSE act.skew:= EditDial ('Neigung einstellen', act.skew DIV 10, Skewstr) * 10; 
  496.                        IF act.skew > 900 THEN  act.skew:= 900;  END;
  497.                        IF act.skew < -900 THEN  act.skew:= -900;  END;
  498.                  END;
  499.                  FontSkew (handle, act.skew);
  500.                  FontInfo (handle, FontActive (handle), act);
  501.                  Update (handle, seleffekt, FALSE);
  502.                  DrawFontfeld (handle);
  503.                  mtDials.DialDraw (selector, Skewstr, 0, clip, FALSE);
  504.                 END;
  505.                 |
  506.    Cancel, Ok:  mtUtils.ExclState (selector, i, SELECTED);
  507.                 selok:= i = Ok;
  508.                 EXIT;
  509.                 |
  510.    ELSE ;
  511.   END; (* CASE *)
  512.  END; (* LOOP *)
  513.  mtDials.DialForm (selector, mtDials.DSHRINK, small, clip);
  514.  mtDials.DialForm (selector, mtDials.DFINISH, r2, r2);
  515.  mtAppl.RestoreMouse;
  516.  
  517.  IF selok THEN
  518.   font:=   act.id;
  519.   point:=  act.point;
  520.   width:=  act.width;
  521.   skew:=   act.skew;
  522.   effekt:= act.effect;
  523.  ELSE
  524.   font:=   old.id;
  525.   point:=  old.point;
  526.   width:=  old.width;
  527.   skew:=   old.skew;
  528.   effekt:= old.effect;
  529.  END;
  530.  j:= MagicVDI.SetTextcolor (handle, old.color);
  531.  
  532.  RETURN selok;
  533. END FontSelector;
  534.  
  535. BEGIN
  536.  small.x:= (MaxWidth DIV 2) - (BoxWidth DIV 2);
  537.  small.y:= (MaxHeight DIV 2) - (BoxHeight DIV 2);
  538.  small.w:= BoxWidth;  small.h:= BoxHeight;
  539.  
  540.  (* Modulinterne Resource laden *)
  541.  
  542.  (* Erstmal Speicher fr Ressource dafr allozieren *)
  543.  ALLOCATE (rscData, TSIZE (tRscData));
  544.  IF rscData = NIL THEN HALT END;   (* Kein Speicher fr interne Ressource *)
  545.  (* Jetzt Resourcedaten kopieren *)
  546.  rscData^ := RscData;
  547.  (* Und jetzt relozieren *)
  548.  IF mtRsc.RelocRsc (rscData, rsc) THEN 
  549.  
  550.   (* Selector initialisieren *)
  551.   selector:= mtRsc.GaddrRsc (rsc, MagicAES.RTREE, Selector);
  552.   b:= mtDials.NewDial (selector);
  553.   
  554.   (* Pfeil links, vorhergehender Font*)
  555.   mtDials.SetUserkey (selector, Fontdown, 75, {}, FALSE, TRUE); 
  556.   
  557.   (* Pfeil rechts, nachfolgender Font *)
  558.   mtDials.SetUserkey (selector, Fontup,   77, {}, FALSE, TRUE);
  559.  
  560.   (* Pfeil runter, verkleinern *)
  561.   mtDials.SetUserkey (selector, Pointdwn, 80, {}, FALSE, TRUE);
  562.  
  563.   (* Pfeil hoch, vergr”žern *)
  564.   mtDials.SetUserkey (selector, Pointup,  72, {}, FALSE, TRUE);
  565.  
  566.   (* Minus, Schm„ler *)
  567.   mtDials.SetUserkey (selector, Sizedown, 74, {}, FALSE, TRUE); (* Ziffernblock *)
  568.   mtDials.SetUserkey (selector, Sizedown, 53, {}, FALSE, TRUE);
  569.  
  570.   (* Plus, Breiter *)
  571.   mtDials.SetUserkey (selector, Sizeup,   78, {}, FALSE, TRUE); (* Ziffernblock *)
  572.   mtDials.SetUserkey (selector, Sizeup,   27, {}, FALSE, TRUE);
  573.  
  574.   (* Slash, Neigung nach links *)
  575.   mtDials.SetUserkey (selector, Skewdown, 101, {}, FALSE, TRUE); (* Ziffernblock *)
  576.   mtDials.SetUserkey (selector, Skewdown, 8, {Bit0}, FALSE, TRUE);
  577.  
  578.   (* Stern, Neigung nach rechts *)
  579.   mtDials.SetUserkey (selector, Skewup, 102, {}, FALSE, TRUE); (* Ziffernblock *)
  580.   mtDials.SetUserkey (selector, Skewup, 27, {Bit0}, FALSE, TRUE);
  581.   
  582.   mtUtils.SetObjcStringAdr (selector, Font, ADR (namestr));
  583.   mtUtils.SetObjcStringAdr (selector, Pointstr, ADR (pointstr));
  584.   mtUtils.SetObjcStringAdr (selector, Sizestr, ADR (widthstr));
  585.   mtUtils.SetObjcStringAdr (selector, Skewstr, ADR (skewstr));
  586.  
  587.   editdial:= mtRsc.GaddrRsc (rsc, MagicAES.RTREE, Edit);
  588.   b:= mtDials.NewDial (editdial);
  589.  
  590.   strings:= mtRsc.GaddrRsc (rsc, MagicAES.RTREE, Strings);
  591.   mtUtils.ObjcString (strings, Stitel, stitel);
  592.   mtUtils.ObjcString (strings, Spoints, spoints);
  593.   mtUtils.ObjcString (strings, Ssize, ssize);
  594.   mtUtils.ObjcString (strings, Sskew, sskew);
  595.  
  596.  ELSE
  597.   HALT; (* Resource laden fehlgeschlagen!  B”ser Fehler!!! *)
  598.  END;
  599. END mtFontselector.
  600.